home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / VISUALBA / DBFM2.ZIP / MAILLIST.BAS < prev    next >
BASIC Source File  |  1994-02-06  |  32KB  |  939 lines
  1. DECLARE SUB QuitFunctions (xk%)
  2. DECLARE SUB BrowseRecords (krs%, ky$, rec$, status%)
  3. DECLARE SUB RecordFunctions (xk%)
  4. DECLARE SUB PrintFunctions (xk%)
  5. DECLARE SUB MiscFunctions (xk%)
  6. DECLARE SUB FileFunctions (xk%)
  7. DECLARE SUB Display (rec$)
  8. DECLARE SUB Help ()
  9. DECLARE SUB FindRecord (krs%, ky$, rec$, status%)
  10. DECLARE SUB AddRecord (krs%, ky$, rec$, status%)
  11. DECLARE SUB DeleteRecord (krs%, ky$, rec$, status%)
  12. DECLARE SUB ChangeRecord (krs%, ky$, rec$, status%)
  13. DECLARE SUB PrintML1 (rec$)
  14. DECLARE SUB PrintML0 ()
  15. DECLARE SUB PrintML9 ()
  16. DECLARE SUB PrintML2 (rec$)
  17. DECLARE SUB ReIndexFile ()
  18. DECLARE SUB CloseFiles ()
  19. DECLARE SUB OpenFiles ()
  20. ' IMDEMO.BAS   by  Marty Francom
  21. ' This program is demonstrates the use of Index Manager. Each index record
  22. ' consists of a key and a pointer to the data file. Such that the key file
  23. ' record (KyF$) is defined:
  24. '  ky$ = KeyString$   rn& = Pointer to data record   krs% = KeyRecordSet
  25. '  Rec$= DataRecord   Rfn%= data record file number  Rfl%= Data record Length
  26. '
  27. ' For the purpose of this demo I open only 1 index and data file however
  28. ' it is a simple matter to open additional index and data files.
  29. DECLARE FUNCTION ColorAttribute% (row%, col%)
  30. DECLARE FUNCTION CurToDollar$ (Cur@, L%)
  31. DECLARE FUNCTION DayOfWeek$ ()
  32. DECLARE FUNCTION FILEXISTS% (FILNAM$)
  33. DECLARE FUNCTION GetBackGround% (row%, col%)
  34. DECLARE FUNCTION GetForeGround% (row%, col%)
  35. DECLARE FUNCTION GetVideoSegment& ()
  36. DECLARE FUNCTION IntgrToDollar$ (Intgr&, L%)
  37. DECLARE FUNCTION KeyIn% ()
  38. DECLARE FUNCTION NumDays& (dt1$, dt2$)
  39. DECLARE FUNCTION NumToString$ (n#, dp%, Ln%)
  40. DECLARE SUB Cdate (dt$)
  41. DECLARE SUB DateEdit (row%, col%, colr%, vk$, dt$, xk%)
  42. DECLARE SUB FastPrint (row%, col%, st$, colr%)
  43. DECLARE SUB EditField (row%, col%, colr%, vk$, st$, xk%)
  44. DECLARE SUB Julian (dt$)
  45. DECLARE SUB PhoneEdit (row%, col%, colr%, vk$, pn$, xk%)
  46. DECLARE SUB PopWindow (TopRow%, LeftCol%, BottomRow%, RightCol%, colr%)
  47. DECLARE SUB PutScreen (file$)
  48. DECLARE SUB RestoreScrn (Scrn$)
  49. DECLARE SUB SaveScrn (Scrn$)
  50. DECLARE SUB Wipe (top%, bottom%, lft%, rght%, colr%)
  51.  
  52. DECLARE SUB AddKeyRec (krs%, ky$, rec$, rn&, status%)
  53. DECLARE SUB CreateOpenClose (krs%)
  54. DECLARE SUB DeleteKeyRec (krs%, ky$, rec$, status%)
  55. DECLARE SUB GetEqual (krs%, ky$, rec$, rn&, status%)
  56. DECLARE SUB GetNext (krs%, ky$, rec$, status%)
  57. DECLARE SUB GetPrev (krs%, ky$, rec$, status%)
  58. DECLARE SUB IndexError (rc%)
  59. DECLARE SUB Info (krs%, xn%, kl%, Rfn%, Rfl%)
  60. '
  61. ' Link in the Index Manager subprogram
  62. DECLARE SUB im (ndx%, opcode$, ndxfn$, keylen%, ky$, datarn&, rc%)
  63. $LINK "IMOB.OBJ"                 ' this must be in main program
  64. $LINK "C:\PB3\UNIT\MYLIB.PBU"    '  "    "   "  "   "      "
  65. ' IMOB.OBJ is an assembly language B-Tree index manager for PowerBasic. As
  66. 'many as 10 index files can be opened, manipulated and maintained all at the
  67. 'same time. IMOB.OBJ is copyright of FRED LEPOW of CDP Consultants. Several
  68. 'versions of IMOB.OBJ are available. For further Information about Index
  69. 'Manager contact Fred Lepow at:
  70. '                     CDP Consultants
  71. '                     1700 Circo Del Cielo Drive
  72. '                     El Cajon, CA.   90202
  73. '                     (619) 440-6482
  74.  
  75. '           Required for Index Manager
  76. DIM xn as shared integer
  77. DIM kl as shared integer
  78. DIM Rfn as shared integer
  79. DIM Rfl as shared integer
  80. DIM ky as shared string
  81. 'DIM Rec as shared string
  82. DIM status as shared integer
  83.  
  84. ' ******************* Beginning Main Program Code **********************
  85. CLS
  86. CALL PutScreen("MailList.Img")
  87. 'krs% = 3: CALL CreateOpenClose(krs%)  'contains pointers to deleted records
  88. krs% = 2: CALL CreateOpenClose(krs%)  'Zip+Name Index
  89. krs% = 1: CALL CreateOpenClose(krs%)  'Name Index + Data Record
  90. xk% = -20
  91. DO
  92.   LOCATE 1, 1, 0
  93.   IF xk% = 0 THEN CALL Display(rec$): xk% = KeyIn%
  94.   SELECT CASE xk%
  95.     CASE -59  'F1 key
  96.       CALL Help: xk% = 0
  97.     CASE 102, 70, -20, -18, -33, -25, -49, -48, -72, -80   'Ff
  98.       IF xk% = 102 OR xk% = 70 THEN CALL FileFunctions(xk%)
  99.       SELECT CASE (xk%)
  100.         CASE -18  'Alt E  goto end of file
  101.           ky$ = STRING$(kl%, 254)
  102.           CALL GetEqual(krs%, ky$, rec$, rn&, status%): xk% = 0
  103.         CASE -20  'Alt T  goto top of file
  104.           ky$ = STRING$(kl%, 32)
  105.           CALL GetEqual(krs%, ky$, rec$, rn&, status%): xk% = 0
  106.         CASE -33  'Alt F  Find a record
  107.           CALL FindRecord(krs%, ky$, rec$, status%): xk% = 0
  108.         CASE -48  'Alt B  browse records
  109.           CALL BrowseRecords(krs%, ky$, rec$, status%): xk% = 0
  110.         CASE -25, -72  'Alt P  UpArrow   get previous record
  111.           CALL GetPrev(krs%, ky$, rec$, status%): xk% = 0
  112.         CASE -49, -80  'Alt N  DnArrow   get next record
  113.           CALL GetNext(krs%, ky$, rec$, status%): xk% = 0
  114.       END SELECT
  115.     CASE 114, 82, -30, -32, -46
  116.       IF xk% = 114 OR xk% = 82 THEN CALL RecordFunctions(xk%)
  117.       SELECT CASE (xk%)
  118.         CASE -30  'Alt A  Add a record
  119.           CALL AddRecord(krs%, ky$, rec$, status%): xk% = 0
  120.           CALL PutScreen("MailList.IMG")
  121.         CASE -32  'Alt D  Delete current record
  122.           CALL DeleteRecord(krs%, ky$, rec$, status%): xk% = 0
  123.           CALL PutScreen("MailList.IMG")
  124.         CASE -46  'Alt C  Change/Edit current record
  125.           CALL ChangeRecord(krs%, ky$, rec$, status%): xk% = 0
  126.           CALL PutScreen("MailList.IMG")
  127.       END SELECT
  128.     CASE 112, 80, -120, -121, -122, -123
  129.       IF xk% = 112 OR xk% = 80 THEN CALL PrintFunctions(xk%)
  130.       SELECT CASE (xk%)
  131.         CASE -120  ' Alt 1  Print current record to mailing label
  132.           CALL PrintML1(rec$): xk% = 0
  133.         CASE -129  ' Alt 0  Print mailing labels of all records
  134.           CALL PrintML0: xk% = 0
  135.         CASE -121  ' Alt 2  Print mailing labels by zip code
  136.           CALL PrintML9: xk% = 0
  137.         CASE -128  ' Alt 9  Print hard copy of current record
  138.           CALL PrintML2(rec$): xk% = 0
  139.       END SELECT
  140.     CASE 109, 77
  141.        CALL MiscFunctions(xk%)
  142.        SELECT CASE (xk%)
  143.          CASE -10  ' ReIndex Current Data File
  144.            CALL ReIndexFile: xk% = 0
  145.          CASE -11  ' Create New Data File & Index
  146.            CALL CloseFiles: xk% = 0
  147.          CASE -12  ' Load New Data File & Index
  148.            CALL OpenFiles: xk% = 0
  149.        END SELECT
  150.     CASE 113, 81, -16, 27
  151.       CALL QuitFunctions(xk%)
  152.       IF xk% = -16 THEN
  153.         CALL CloseFiles: EXIT DO
  154.       END IF
  155.     CASE ELSE
  156.       BEEP: xk% = 0
  157.   END SELECT
  158. LOOP
  159. CLS : END
  160.  
  161. SUB AddRecord (krs%, ky$, rec$, status%)
  162.   st$ = "MailList.Img": CALL PutScreen(st$)
  163.   new$ = SPACE$(683): cn% = 1
  164.   DO
  165.     SELECT CASE cn%
  166.       CASE 1
  167.         st$ = MID$(new$, 2, 28)
  168.         xk% = 11: CALL EditField(6, 20, 79, "", st$, xk%)
  169.         MID$(new$, 2, 16) = st$
  170.       CASE 2
  171.         st$ = MID$(new$, 31, 30)
  172.         xk% = 11: CALL EditField(8, 20, 79, "", st$, xk%)
  173.         MID$(new$, 31, 30) = st$
  174.       CASE 3
  175.         st$ = MID$(new$, 61, 30)
  176.         xk% = 11: CALL EditField(10, 20, 79, "", st$, xk%)
  177.         MID$(new$, 61, 30) = st$
  178.       CASE 4
  179.         st$ = MID$(new$, 91, 14)
  180.         xk% = 11: CALL EditField(12, 20, 79, "", st$, xk%)
  181.         MID$(new$, 91, 14) = st$
  182.       CASE 5
  183.         st$ = MID$(new$, 105, 2)
  184.         xk% = 11: CALL EditField(12, 45, 79, "", st$, xk%)
  185.         MID$(new$, 105, 2) = st$
  186.       CASE 6
  187.         st$ = MID$(new$, 107, 5)
  188.         xk% = 2: CALL EditField(12, 58, 79, "", st$, xk%)
  189.         MID$(new$, 107, 5) = st$
  190.         st$ = MID$(new$, 112, 4)
  191.         xk% = 2: CALL EditField(12, 64, 79, "", st$, xk%)
  192.         MID$(new$, 112, 4) = st$
  193.       CASE 7
  194.         st$ = MID$(new$, 116, 3)
  195.         xk% = 2: CALL EditField(14, 21, 79, "", st$, xk%)
  196.         MID$(new$, 116, 3) = st$
  197.         st$ = MID$(new$, 119, 3)
  198.         xk% = 2: CALL EditField(14, 26, 79, "", st$, xk%)
  199.         MID$(new$, 119, 3) = st$
  200.         st$ = MID$(new$, 122, 4)
  201.         xk% = 2: CALL EditField(14, 30, 79, "", st$, xk%)
  202.         MID$(new$, 122, 4) = st$
  203.       CASE 8
  204.         st$ = MID$(new$, 126, 62)
  205.         xk% = 1: CALL EditField(16, 10, 79, "", st$, xk%)
  206.         MID$(new$, 126, 62)